home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b2fix.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  6.5 KB  |  246 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /* $Header: b2fix.c,v 1.4 85/08/22 16:55:08 timo Exp $ */
  4.  
  5. /* Fix unparsed expr/test */
  6.  
  7. #include "b.h"
  8. #include "b1obj.h"
  9. #include "b2exp.h"
  10. #include "b2nod.h"
  11. #include "b2gen.h" /* Must be after b2nod.h */
  12. #include "b2par.h" /* For is_b_tag */
  13. #include "b3err.h"
  14. #include "b3env.h"
  15. #include "b3sem.h"
  16.  
  17. Forward parsetree fix_expr(), fix_test();
  18.  
  19. Visible Procedure f_eunparsed(pt) parsetree *pt; {
  20.     f_unparsed(pt, fix_expr);
  21. }
  22.  
  23. Visible Procedure f_cunparsed(pt) parsetree *pt; {
  24.     f_unparsed(pt, fix_test);
  25. }
  26.  
  27. Hidden Procedure f_unparsed(pt, fct) parsetree *pt, (*fct)(); {
  28.     parsetree t= *pt; unpadm adm;
  29.     struct state v;
  30.     /* Ignore visits done during resolving UNPARSED: */
  31.     hold(&v);
  32.     initunp(&adm, *Branch(t, UNP_SEQ));
  33.     t= (*fct)(&adm);
  34.     release(*pt);
  35.     *pt= t;
  36.     jumpto(NilTree);
  37.     let_go(&v);
  38. }
  39.  
  40. /* ********************************************************************    */
  41.  
  42. #define Fld        *Field(Node(adm), N_fld(adm))
  43. #define Is_fld        (N_fld(adm) < Nfields(Node(adm)))
  44. #define Get_fld(v)    v= copy(Fld); N_fld(adm)++
  45.  
  46. Hidden Procedure initunp(adm, root) unpadm *adm; value root; {
  47.     Prop(adm)= No;
  48.     Node(adm)= root;
  49.     N_fld(adm)= 0;
  50. }
  51.  
  52. /* ********************************************************************    */
  53.  
  54. Hidden bool f_dyafun(v, s, fct) value v, *fct; string s; {
  55.     value t= Vnil; 
  56.     bool is= Is_text(v) && compare(v, t= mk_text(s)) == 0 && is_dyafun(v, fct);
  57.     release(t);
  58.     return is;
  59. }
  60.  
  61. Hidden bool f_dyatag(v, fct) value v, *fct; {
  62.     return Is_text(v) && is_b_tag(v) && is_dyafun(v, fct);
  63. }
  64.  
  65. Visible bool is_b_tag(v) value v; {
  66.     value a, b, c; bool x;
  67.     /* REPORT v|1 in {'a' .. 'z'} */
  68.     a= mk_charrange(b= mk_text("a"), c= mk_text("z"));
  69.     release(b); release(c);
  70.     x= in(b= curtail(v, one), a);
  71.     release(a); release(b);
  72.     return x;
  73. }
  74.  
  75. /* ********************************************************************    */
  76.  
  77. Hidden Procedure fix_formula(adm, v, fct, lev, right)
  78.     unpadm *adm; parsetree *v, (*right)(); value fct; intlet lev; {
  79.  
  80.     parsetree w; value name;
  81.     if (Level(adm) < lev) fixerr(Prio);
  82.     Get_fld(name);
  83.     w= (*right)(adm);
  84.     if (Trim(adm)) *v= node3(b_behead(name) ? BEHEAD : CURTAIL, *v, w);
  85.     else *v= node5(DYAF, *v, name, w, copy(fct));
  86. }
  87.  
  88. /* ********************************************************************    */
  89.  
  90. Hidden bool b_expr_opr(v, fct) value v, *fct; {
  91.     return    f_dyafun(v, "^^", fct) || f_dyafun(v, "><", fct) ||
  92.         f_dyafun(v, "<<", fct) || f_dyafun(v, ">>", fct) ||
  93.         f_dyatag(v, fct);
  94. }
  95.  
  96. Forward parsetree fix_term(), fix_factor(), fix_primary(), fix_base();
  97.  
  98. Hidden parsetree fix_expr(adm) unpadm *adm; {
  99.     parsetree v; value fct;
  100.     if (!Is_fld) {
  101.         fixerr(MESS(4700, "no expression where expected"));
  102.         return NilTree;
  103.     }
  104.     v= fix_term(adm);
  105.     if (Is_fld && b_expr_opr(Fld, &fct)) {
  106.         if (nodetype(v) == DYAF) fixerr(Prio);
  107.         fix_formula(adm, &v, fct, L_expr, fix_base);
  108.     }
  109.     if (Is_fld && !Prop(adm)) {
  110.         value f;
  111.         if (Is_text(Fld) && is_dyafun(Fld, &f)) fixerr(Prio);
  112.         else fixerr(MESS(4701, "something unexpected following expression"));
  113.     }
  114.     return v;
  115. }
  116.  
  117. Hidden parsetree fix_test(adm) unpadm *adm; {
  118.     parsetree v; value w= Vnil, f= Vnil; value *aa;
  119.     if (!Is_fld) {
  120.         fixerr(MESS(4702, "no test where expected"));
  121.         return NilTree;
  122.     }
  123.     if (Is_text(Fld)) {
  124.         Get_fld(v);
  125.         if (is_zerprd(v, &f)) {
  126.             if (Is_fld)
  127.                 fixerr(MESS(4703, "something unexpected following test"));
  128.             return node3(TAGzerprd, v, copydef(f));
  129.         } else if (aa= envassoc(refinements, v)) {
  130.             if (!Is_fld) return node3(TAGrefinement, v, copy(*aa));
  131.         } else if (is_monprd(v, &f)) 
  132.             return node4(MONPRD, v, fix_expr(adm), copydef(f));
  133.         release(v);
  134.         N_fld(adm)--;
  135.     }
  136.     Prop(adm)= Yes;
  137.     v= fix_expr(adm);
  138.     Prop(adm)= No;
  139.     if (!(Is_fld && Is_text(Fld) && is_dyaprd(Fld, &f)))
  140.         fixerr(MESS(4704, "no test where expected"));
  141.     if (Is_fld) Get_fld(w);
  142.     return node5(DYAPRD, v, w, fix_expr(adm), copydef(f));
  143. }
  144.  
  145. /* ********************************************************************    */
  146.  
  147. Hidden bool b_term_opr(v, fct) value v, *fct; {
  148.     return    f_dyafun(v, "+", fct) || f_dyafun(v, "-", fct) ||
  149.         f_dyafun(v, "^", fct);
  150. }
  151.  
  152. Hidden parsetree fix_term(adm) unpadm *adm; {
  153.     parsetree v; value fct;
  154.     v= fix_factor(adm);
  155.     while (Is_fld && b_term_opr(Fld, &fct))
  156.         fix_formula(adm, &v, fct, L_term, fix_factor);
  157.     return v;
  158. }
  159.  
  160. /* ********************************************************************    */
  161.  
  162. Hidden parsetree fix_factor(adm) unpadm *adm; {
  163.     parsetree v; value fct;
  164.     v= fix_primary(adm);
  165.     while (Is_fld && f_dyafun(Fld, "*", &fct))
  166.         fix_formula(adm, &v, fct, L_factor, fix_primary);
  167.     if (Is_fld && f_dyafun(Fld, "/", &fct))
  168.         fix_formula(adm, &v, fct, L_factor, fix_primary);
  169.     return v;
  170. }
  171.  
  172. /* ********************************************************************    */
  173.  
  174. Hidden parsetree fix_primary(adm) unpadm *adm; {
  175.     parsetree v; value fct;
  176.     v= fix_base(adm);
  177.     if (Is_fld && f_dyafun(Fld, "#", &fct))
  178.         fix_formula(adm, &v, fct, L_number, fix_base);
  179.     if (Is_fld && f_dyafun(Fld, "**", &fct))
  180.         fix_formula(adm, &v, fct, L_power, fix_base);
  181.     return v;
  182. }
  183.  
  184. /* ********************************************************************    */
  185.  
  186. Forward parsetree fix_rbase();
  187.  
  188. Hidden parsetree fix_base(adm) unpadm *adm; {
  189.     Level(adm)= L_expr;
  190.     Trim(adm)= No;
  191.     return fix_rbase(adm);
  192. }
  193.  
  194. Forward parsetree fix_monadic();
  195.  
  196. Hidden parsetree fix_rbase(adm) unpadm *adm; {
  197.     parsetree v, w= NilTree; value f;
  198.     if (!Is_fld && !Prop(adm)) {
  199.         fixerr(MESS(4705, "no expression where expected"));
  200.         return NilTree;
  201.     }
  202.     if (Is_parsetree(Fld)) {
  203.         f_expr(Branch(Node(adm), N_fld(adm)));
  204.         Get_fld(v);
  205.         fix_trim(adm, &v);
  206.         return v;
  207.     }
  208.     Get_fld(v);
  209.     if (modify_tag(v, &w)) fix_trim(adm, &w);
  210.     else if (is_monfun(v, &f)) w= fix_monadic(adm, v, f);
  211.     else {
  212.         fixerr2(v, MESS(4706, " has not yet received a value"));
  213.         release(v);
  214.     }
  215.     return w;
  216. }
  217.  
  218. Hidden Procedure adjust_level(adm, lev)    unpadm *adm; intlet lev; {
  219.     if (lev < Level(adm)) Level(adm)= lev;
  220. }
  221.  
  222. Hidden parsetree fix_monadic(adm, v, fct) unpadm *adm; value v, fct; {
  223.     if (!Trim(adm)) {
  224.         if (b_minus(v)) adjust_level(adm, L_factor); 
  225.         else if (b_number(v)) adjust_level(adm, L_power); 
  226.         else if (!(b_plus(v) || b_about(v))) 
  227.             adjust_level(adm, L_bottom);
  228.     }
  229.     if (!Trim(adm) && b_minus(v)) {
  230.         intlet lev= Level(adm);
  231.         parsetree t= node4(MONF, v, fix_primary(adm), copydef(fct));
  232.         adjust_level(adm, lev);
  233.         return t;
  234.     } else 
  235.         return node4(MONF, v, fix_rbase(adm), copydef(fct));
  236. }
  237.  
  238. Hidden Procedure fix_trim(adm, v) unpadm *adm; parsetree *v; {
  239.     if (!Trim(adm)) {
  240.         Trim(adm)= Yes;
  241.         while (Is_fld && (b_behead(Fld) || b_curtail(Fld)))
  242.             fix_formula(adm, v, Vnil, L_bottom, fix_rbase);
  243.         Trim(adm)= No;
  244.     }
  245. }
  246.